home *** CD-ROM | disk | FTP | other *** search
/ CICA 1993 April / CICA MS Windows - April 1993.iso / unzipped / programr / tp / tpwmi2 / percent.pas < prev    next >
Pascal/Delphi Source File  |  1992-08-12  |  8KB  |  292 lines
  1. unit Percent;
  2.  
  3. interface
  4. uses WinProcs,WinTypes,Frames,Strings,BWCC,WObjects;
  5.  
  6. const OutWidth=3;
  7.             max_Lines=2;
  8.  
  9. type
  10.     PPercentDlg = ^TPercentDlg;
  11.     TPercentDlg = object(TDlgWindow)
  12.         Blank : array[0..1] of char;
  13.         PctColor,TextColor:TColorRef;
  14.         PctLow,PctHigh,PctCurrent,PctOld:array[1..max_Lines] of integer;
  15.         DisplayPct:boolean;
  16.         Lines:integer;
  17.         BackBrush:HBrush;
  18.         PctR:array[1..max_Lines] of TRect;
  19.         CancelBool:boolean;
  20.         constructor Init(AParent:PWindowsObject; AName:PChar; NumLines:integer; DrawTxt:boolean);
  21.         destructor Done; virtual;
  22.         procedure SetupWindow; virtual;
  23.         function GetClassName:PChar; virtual;
  24.         procedure GetWindowClass(var AWndClass:TWndClass); virtual;
  25.         procedure SetDefaults; virtual;
  26.         procedure SetPctLevel(PctLevel:integer; Line:integer); virtual;
  27.         procedure AddPctLevel(PctLevel:integer; Line:integer); virtual;
  28.         procedure DelPctLevel(PctLevel:integer; Line:integer); virtual;
  29.         procedure DrawPct; virtual;
  30.         procedure DrawPercent(Line:integer); virtual;
  31.         procedure DrawPctText(Line:integer); virtual;
  32.         procedure SetText(Text:PChar;Line:integer); virtual;
  33.         procedure WMPaint(var Msg:TMessage); virtual $0088;
  34.         procedure Cancel(var Msg:TMessage); virtual id_First+id_Cancel;
  35.         procedure Update; virtual;
  36.     end;
  37.  
  38. implementation
  39.  
  40. constructor TPercentDlg.Init(AParent:PWindowsObject; AName:PChar; NumLines:integer; DrawTxt:boolean);
  41. begin
  42.     TDlgWindow.Init(AParent,AName);
  43.     CancelBool := false;
  44.     Lines := NumLines;
  45.     if Lines > max_Lines then Lines := max_Lines;
  46.     EnableKBHandler;
  47.     DisplayPct := DrawTxt;
  48.     StrCopy(Blank,' ');
  49. end;
  50.  
  51. destructor TPercentDlg.Done;
  52. begin
  53.     DeleteObject(BackBrush);
  54.     TDlgWindow.Done;
  55. end;
  56.  
  57. procedure TPercentDlg.SetupWindow;
  58. begin
  59.     TDlgWindow.SetupWindow;
  60.     SetDefaults;
  61.     SendMessage(HWindow,wm_SetText,0,longint(@Blank));
  62.     DrawPct;
  63. end;
  64.  
  65. function TPercentDlg.GetClassName:PChar;
  66. begin
  67.     GetClassName := 'Percent_Dialog';
  68. end;
  69.  
  70. procedure TPercentDlg.GetWindowClass(var AWndClass:TWndClass);
  71. begin
  72.     TDlgWindow.GetWindowClass(AWndClass);
  73.     AWndClass.lpfnWndProc := Addr(BWCCDefWindowProc);
  74. end;
  75.  
  76. procedure TPercentDlg.SetDefaults;
  77. var DC:HDC;
  78.         Point:TPoint;
  79.         DlgR:TRect;
  80.         count:integer;
  81. begin
  82.     for count := 1 to Lines do
  83.     begin
  84.         PctLow[count]:=0;
  85.         PctHigh[count]:=100;
  86.         PctCurrent[count]:=PctLow[count];
  87.         PctOld[count]:=-1;
  88.     end;
  89.  
  90.     GetClientRect(HWindow,DlgR);
  91.     Point.X := DlgR.left; Point.Y := DlgR.top;
  92.     ClientToScreen(HWindow,Point);
  93.     DlgR.left := Point.X; DlgR.top := Point.Y;
  94.     Point.X := DlgR.right; Point.Y := DlgR.bottom;
  95.     ClientToScreen(HWindow,Point);
  96.     DlgR.right := Point.X; DlgR.bottom := Point.Y;
  97.  
  98.     for count := 1 to Lines do
  99.     begin
  100.         GetWindowRect(GetDlgItem(HWindow,200+count),PctR[count]);
  101.         with PctR[count] do
  102.         begin
  103.             top := top - DlgR.top;
  104.             bottom := bottom - DlgR.top;
  105.             left := left - DlgR.left;
  106.             right := right - DlgR.left;
  107.         end;
  108.     end;
  109.     PctColor:=RGB(64,64,64);
  110.     TextColor:=RGB(0,0,128);
  111. end;
  112.  
  113. procedure TPercentDlg.SetPctLevel(PctLevel:integer;Line:integer);
  114. begin
  115.     PctCurrent[Line]:=PctLevel;
  116.     if PctLevel>PctHigh[Line] then PctCurrent[Line]:=PctHigh[Line];
  117.     if PctLevel<PctLow[Line] then PctCurrent[Line]:=PctLow[Line];
  118.     Update;
  119.     DrawPct;
  120. end;
  121.  
  122. procedure TPercentDlg.AddPctLevel(PctLevel:integer;Line:integer);
  123. begin
  124.     PctCurrent[Line]:=PctCurrent[Line]+PctLevel;
  125.     if PctCurrent[Line]>PctHigh[Line] then PctCurrent[Line]:=PctHigh[Line];
  126.     if PctCurrent[Line]<PctLow[Line] then PctCurrent[Line]:=PctLow[Line];
  127.     Update;
  128.     DrawPct;
  129. end;
  130.  
  131. procedure TPercentDlg.DelPctLevel(PctLevel:integer;Line:integer);
  132. begin
  133.     PctCurrent[Line]:=PctCurrent[Line]-PctLevel;
  134.     if PctCurrent[Line]>PctHigh[Line] then PctCurrent[Line]:=PctHigh[Line];
  135.     if PctCurrent[Line]<PctLow[Line] then PctCurrent[Line]:=PctLow[Line];
  136.     Update;
  137.     DrawPct;
  138. end;
  139.  
  140. procedure TPercentDlg.DrawPct;
  141. var count:integer;
  142. begin
  143.     for count := 1 to Lines do
  144.         if PctOld[count] <> PctCurrent[count] then
  145.         begin
  146.             PctOld[count] := PctCurrent[count];
  147.             DrawPercent(count);
  148.             if DisplayPct and (count = Lines) then
  149.                 DrawPctText(count);
  150.         end;
  151.     if PctCurrent[Lines] = PctLow[Lines] then
  152.         DrawPercent(Lines);
  153. end;
  154.  
  155. procedure TPercentDlg.DrawPercent(Line:integer);
  156. var InR,OutR:TRect;
  157.         TempR:TRect;
  158.         PaintDC:HDC;
  159.         TheBrush,OldBrush:HBrush;
  160.         ThePen,OldPen:HPen;
  161.         BuffS:string;
  162.         Buffer:array[0..10] of char;
  163.         MemDC:HDC;
  164.         TheBits,OldBits:HBitmap;
  165. begin
  166.     TempR := PctR[Line];
  167.     TempR.right:=TempR.right-TempR.left;
  168.     TempR.left:=0;
  169.     TempR.bottom:=TempR.bottom-TempR.top;
  170.     TempR.top:=0;
  171.     InR:=TempR;
  172.     OutR:=TempR;
  173.     InflateRect(InR,-1,-1);
  174.     InflateRect(OutR,-1,-1);
  175.     InR.bottom:=InR.bottom+1;
  176.     InR.right:=InR.right+1;
  177.     OutR.bottom:=OutR.bottom-1;
  178.     if (PctCurrent[Line]-PctLow[Line])<>0 then
  179.     InR.left:=InR.left+integer(Trunc((InR.right-InR.left) * ((PctCurrent[Line]-PctLow[Line]) / (PctHigh[Line]-PctLow[Line]))) );
  180.     OutR.right:=InR.left+1;
  181.     PaintDC:=GetDC(HWindow);
  182.     MemDC:=CreateCompatibleDC(PaintDC);
  183.     TheBits:=CreateCompatibleBitmap(PaintDC,TempR.right,TempR.bottom);
  184.     OldBits:=SelectObject(MemDC,TheBits);
  185.  
  186.     TheBrush:=GetStockObject(Null_Brush);
  187.     OldBrush:=SelectObject(MemDC,TheBrush);
  188.     ThePen:=CreatePen(ps_Solid,1,GetSysColor(color_WindowFrame));
  189.     OldPen:=SelectObject(MemDC,ThePen);
  190.     Rectangle(MemDC,TempR.left,TempR.top,TempR.right,TempR.bottom);
  191.     SelectObject(MemDC,OldBrush);
  192.     DeleteObject(TheBrush);
  193.     SelectObject(MemDC,OldPen);
  194.     DeleteObject(ThePen);
  195.  
  196.     if (PctCurrent[Line]<>PctHigh[Line]) then
  197.     begin
  198.         TheBrush:=CreateSolidBrush($00C0C0C0);
  199.         OldBrush:=SelectObject(MemDC,TheBrush);
  200.         ThePen:=GetStockObject(Null_Pen);
  201.         OldPen:=SelectObject(MemDC,ThePen);
  202.         Rectangle(MemDC,InR.left,InR.top,InR.right,InR.bottom);
  203.         InR.right:=InR.right-2; InR.bottom:=InR.bottom-2;
  204.         InflateRect(InR,-2,-2);
  205.         DrawInFrame(MemDC,InR,true,1);
  206.         InflateRect(InR,2,2);
  207.         InR.right:=InR.right+2; InR.left:=InR.left+1; InR.bottom:=InR.bottom+2;
  208.         SelectObject(MemDC,OldBrush);
  209.         DeleteObject(TheBrush);
  210.         SelectObject(MemDC,OldPen);
  211.         DeleteObject(ThePen);
  212.     end;
  213.  
  214.     if PctCurrent[Line]<>PctLow[Line] then
  215.     begin
  216.         if OutR.right>(TempR.right-2) then OutR.right:=TempR.right-2;
  217.         if Lines = Line then
  218.             DrawOutFrame(MemDC,OutR,true,OutWidth) else
  219.             DrawOutFrame(MemDC,OutR,true,OutWidth-1);
  220.     end;
  221.  
  222.     BitBlt(PaintDC,PctR[Line].left,PctR[Line].top,TempR.right,TempR.bottom,MemDC,0,0,srcCopy);
  223.     SelectObject(MemDC,OldBits);
  224.     DeleteObject(TheBits);
  225.     ReleaseDC(GetDlgItem(HWindow,201),PaintDC);
  226.     DeleteDC(MemDC);
  227. end;
  228.  
  229. procedure TPercentDlg.DrawPctText(Line:integer);
  230. var PaintR:TRect;
  231.         Buffer:array[0..10] of char;
  232.         BuffS:string[10];
  233.         Extent:longint;
  234.         PaintDC:HDC;
  235. begin
  236.     PaintDC := GetDC(HWindow);
  237.     SetTextAlign(PaintDC,ta_Top or ta_Left);
  238.     SetBkMode(PaintDC,Transparent);
  239.     SetTextColor(PaintDC,TextColor);
  240.     Str(PctCurrent[Line],BuffS);
  241.     BuffS := BuffS + '%';
  242.     StrPCopy(Buffer,BuffS);
  243.     Extent := GetTextExtent(PaintDC,Buffer,StrLen(Buffer));
  244.     TextOut(PaintDC,
  245.             PctR[Line].left+((PctR[Line].right-PctR[Line].left-Loword(Extent)) div 2),
  246.             PctR[Line].top+((PctR[Line].bottom-PctR[Line].top-Hiword(Extent)) div 2),
  247.             Buffer,StrLen(Buffer));
  248.     ReleaseDC(HWindow,PaintDC);
  249. end;
  250.  
  251. procedure TPercentDlg.SetText(Text:PChar;Line:integer);
  252. var Buffer:array[0..100] of char;
  253. begin
  254.     if Text <> nil then
  255.         StrCopy(Buffer,Text) else
  256.         StrCopy(Buffer,Blank);
  257.     if Line <> 0 then
  258.         SendDlgItemMsg(100+Line,wm_SetText,0,longint(@Buffer)) else
  259.         SendMessage(HWindow,wm_SetText,0,longint(@Buffer));
  260.     Update;
  261. end;
  262.  
  263. procedure TPercentDlg.WMPaint(var Msg:TMessage);
  264. var count:integer;
  265. begin
  266.     for count := 1 to Lines do
  267.         PctOld[count] := -1;
  268.     DrawPct;
  269. end;
  270.  
  271. procedure TPercentDlg.Cancel(var Msg:TMessage);
  272. begin
  273.     CancelBool := true;
  274. end;
  275.  
  276. procedure TPercentDlg.Update;
  277. var Msg:TMsg;
  278. begin
  279.     if Parent <> nil then
  280.     begin
  281.         while PeekMessage(Msg,0,0,0,pm_Remove) do
  282.         if not IsDialogMessage(HWindow,Msg) then
  283.         begin
  284.             TranslateMessage(Msg);
  285.             DispatchMessage(Msg);
  286.         end;
  287.     end;
  288. end;
  289.  
  290. End.
  291.  
  292.